Trabajo final 7

library(tidyverse)
library(openxlsx)
library(gt)
library(modeltime)
library(timetk)
library(sknifedatar)
library(tidymodels)
library(feasts)
library(forecast)
library(tsibble)
library(fable)
library(fabletools)
library(urca)
library(plotly)

Estructuración de base de datos

CONSOLIDADO <- read.xlsx("C:\\Users\\admin\\OneDrive - Universidad Central del Ecuador\\Escritorio\\IESS\\Trabajo4_Pronostico\\Data\\PORTAFOLIO_CONSOLIDADO_PROYECCION.xlsx",
                         detectDates = T)

CONSOLIDADO1 <-  CONSOLIDADO %>% pivot_longer(!INVERSION,
                                              names_to = "FECHA",
                                              values_to = "RENDIMIENTOS")%>% 
                 mutate(FECHA = as.Date(FECHA))

listas <- split(CONSOLIDADO1,CONSOLIDADO1$INVERSION)

IP <- listas$PRIVATIVAS[-1]#PRIVATIVAS

Visualizando base de datos

tabla2 <- IP %>% 
  gt() %>% 
  tab_header(title='Inversiones privativas', 
             subtitle='Portafolio IESS') %>%
  fmt_number(
    columns = vars(RENDIMIENTOS),
    decimals = 2,
    suffixing = TRUE,
    use_seps = TRUE
  ) %>% 
  tab_footnote(
    footnote = "Fuente: Histórico portafolio")%>% 
  tab_footnote(
  footnote = "Elaborado por: Víctor Vallejo")
gtsave(tabla2, file = "t2.html")

• Para la presente aplicación se cuenta con una serie histórica sobre inversiones privativas pertenecientes al IESS la cual va desde Diciembre 2013 hasta marzo 2023 con una periodicidad de tipo mensual.

Visualización gráfica de la serie

IP %>% 
  plot_time_series(.date_var = FECHA, 
                   .value = RENDIMIENTOS, 
                   .interactive = T, 
                   .line_size = 0.15,.title = "Evolución inversiones privativas",.x_lab = "Tiempo",.y_lab = "Valores")

• Se puede apreciar que la serie en estudio cuenta con un fuerte componente tendencial, creciente durante los meses, con pequeñas caidas a lo largo del año 2021, con esto ya da luces que las inversiones privativas no presentan un comportamiento estacional a lo largo de los años.

Contraste de hipótesis sobre estacionariedad

Phillips-Perron

\(H_0:\) Raíz unitaria (No estacionariedad)

\(H_1:\) No raíz unitaria estacionariedad

testpp <- ur.pp(tsdata,
                type = c("Z-tau"),
                model = c("trend"),
                lags = c("short"))
summary(testpp)

################################## 
# Phillips-Perron Unit Root Test # 
################################## 

Test regression with intercept and trend 


Call:
lm(formula = y ~ y.l1 + trend)

Residuals:
       Min         1Q     Median         3Q        Max 
-161439916  -20628301    8513409   27379920   89930829 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 2.884e+08  7.186e+07   4.014 0.000111 ***
y.l1        9.753e-01  7.716e-03 126.401  < 2e-16 ***
trend       4.060e+05  4.256e+05   0.954 0.342146    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 41380000 on 108 degrees of freedom
Multiple R-squared:  0.9994,    Adjusted R-squared:  0.9994 
F-statistic: 9.769e+04 on 2 and 108 DF,  p-value: < 2.2e-16


Value of test-statistic, type: Z-tau  is: -2.5551 

           aux. Z statistics
Z-tau-mu              2.4958
Z-tau-beta            0.9957

Critical values for Z statistics: 
                     1pct      5pct     10pct
critical values -4.042903 -3.450435 -3.150299

• Como el valor de tabla |-2.5551| no es mayor a ninguno de los valores criticos(-4.134754, -3.493511, -3.175277), entonces no se puede rechazar Ho por lo que se dice que hay raíz unitaria o la serie no es estacionaria.

Elliot, Rothenberg and Stock Unit Root Test

\(H_0:\) Raíz unitaria (No estacionariedad)

\(H_1:\) No raíz unitaria estacionariedad

erstest <- ur.ers(tsdata,
                  type = c("DF-GLS"),
                  model = c("trend"),
                  lag.max = 4)
summary(erstest)

############################################### 
# Elliot, Rothenberg and Stock Unit Root Test # 
############################################### 

Test of type DF-GLS 
detrending of series with intercept and trend 


Call:
lm(formula = dfgls.form, data = data.dfgls)

Residuals:
       Min         1Q     Median         3Q        Max 
-157929887  -18068835    3871461   19257608   92669508 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
yd.lag       -0.005848   0.005932  -0.986   0.3265    
yd.diff.lag1  0.435966   0.097769   4.459 2.12e-05 ***
yd.diff.lag2  0.023942   0.104776   0.229   0.8197    
yd.diff.lag3  0.203372   0.104237   1.951   0.0538 .  
yd.diff.lag4  0.137567   0.097609   1.409   0.1618    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 39840000 on 102 degrees of freedom
Multiple R-squared:  0.4361,    Adjusted R-squared:  0.4085 
F-statistic: 15.78 on 5 and 102 DF,  p-value: 1.74e-11


Value of test-statistic is: -0.9859 

Critical values of DF-GLS are:
                 1pct  5pct 10pct
critical values -3.46 -2.93 -2.64

• Como el valor de tabla |-0.9859| no es mayor ninguno de los valores críticos (-3.46,-2.93,-2.64). Entonces no se puede rechazar Ho por lo que se dice que hay raíz unitaria o la serie no es estacionaria.

Descomposición de la serie de tiempo

• En el gráfico adjunto se pueden apreciar la descomposición de la serie de tiempo(tendencia, estacionalidad y ruído). Como ya se había comentado antes, la serie presenta un fuerte componente tendencial, con la descomposición se puede apreciar que pareciera no haber estacionalidad en la serie.

Estacionalidad de la serie

• Analizando mas detalladamente la estacionalidad de manera gráfica, se puede observar que en todos los años el comportamiento se mantiene similar, no hay un comportamiento a parte de manera mensual ni trimestral.

Función de autocorrelación simple y parcial

• Considerando el comportamiento bastante particular de la la función de autocorrelación simple no queda claro el número de rezagos para la media móvil para considerar en un eventual modelo ARIMA.

Modelamiento de la serie

• Para este apartado dada las caracteristicas de la seria se hará uso de un modelo ‘Holt-winters doble’ sobre el cual se pretende modelar el componente tendencial de la serie para ser usada luego para pronóstico.

modeloIP <- HoltWinters(tsdata,gamma = 0)#Mejor modelo para inversiones privativas
modeloIP

Holt-Winters exponential smoothing with trend and additive seasonal component.

Call:
HoltWinters(x = tsdata, gamma = 0)

Smoothing parameters:
 alpha: 1
 beta : 0.1208015
 gamma: 0

Coefficients:
             [,1]
a    1.168255e+10
b    4.189690e+07
s1  -2.012820e+07
s2  -3.182958e+07
s3  -7.185083e+07
s4  -2.433689e+07
s5  -4.136174e+04
s6   3.815950e+07
s7   5.250430e+07
s8   5.350019e+07
s9   3.107170e+07
s10  1.497194e+07
s11 -2.814405e+07
s12 -1.387672e+07

Pronóstico

forecast(modeloIP,h = 9,level = 95,alpha = 0.05)

         Point Forecast       Lo 95       Hi 95
Apr 2023    11704321036 11530922671 11877719402
May 2023    11734516550 11474061124 11994971977
Jun 2023    11736392198 11398475576 12074308819
Jul 2023    11825803034 11413496873 12238109195
Aug 2023    11891995461 11406052310 12377938612
Sep 2023    11972093217 11412184023 12532002412
Oct 2023    12028334920 11393554183 12663115657
Nov 2023    12071227707 11360338744 12782116669
Dec 2023    12090696114 11302263847 12879128381

autoplot(forecast(modeloIP,h = 9,level = 95,alpha = 0.05))+
  labs(title = "Pronóstico inversiones privativas Abril2023-Diciembre2023",
       subtitle = "Suavización exponencial doble(Hold)",
       x = "Tiempo",
       y = "Valores",
       caption = "Fuente: Histórico portafolio \n Elaboración: Víctor Vallejo")  

• Con base en los pronósticos realizados para los meses de abril 2023 a Diciembre 2023, se puede apreciar que dichos valores comparte conservadoramente la tendencia de la serie original.